home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / GSCOLR.for < prev    next >
Text File  |  1991-05-01  |  1KB  |  42 lines
  1.         SUBROUTINE GSCOLR(ICOLOR,IERR)
  2.         IMPLICIT NONE
  3.         INTEGER ICOLOR,IERR
  4.     INTEGER*1 IAND
  5.         REAL*4 DUMMY
  6.  
  7.         INCLUDE DIGLIB$KOM:GCDCHR.PRM
  8. C
  9. C       SELECT COLOR "ICOLOR" ON CURRENT DEVICE
  10. C
  11.         LOGICAL*1 LNOBKG
  12.         IERR = 0
  13. C
  14. C       LNOBKG SET TO TRUE IF NO BACKGROUND COLOR EXISTS ON THIS DEVICE
  15. C
  16.         LNOBKG = IAND(IDVBTS,4) .EQ. 0
  17. C
  18. C       FIRST, ERROR IF BACKGROUND COLOR REQUESTED AND DEVICE DOES NOT
  19. C       SUPPORT BACKGROUND COLOR WRITE.
  20. C
  21.         IF (ICOLOR .EQ. 0 .AND. LNOBKG) GO TO 900
  22. C
  23. C       SECOND, ERROR IF COLOR REQUESTED IS LARGER THAN THE NUMBER OF
  24. C       FOREGROUND COLORS AVAILABLE ON THIS DEVICE
  25. C
  26.         IF (ICOLOR .GT. NDCLRS) GO TO 900
  27. C
  28. C       IF ONLY 1 FOREGROUND COLOR AND NO BACKGROUND COLOR, THEN
  29. C       DRIVER WILL NOT SUPPORT SET COLOR, AND OF COURSE, THE
  30. C       COLOR MUST BE COLOR 1 TO HAVE GOTTEN THIS FAR, SO JUST RETURN
  31. C
  32.         IF (NDCLRS .EQ. 1 .AND. LNOBKG) RETURN
  33. C
  34. C       ALL IS OK, SO SET THE REQUESTED COLOR
  35. C
  36. 100     CALL GSDRVR(8,FLOAT(ICOLOR),DUMMY)
  37.         RETURN
  38. 900     IERR = -1
  39.         RETURN
  40.         END
  41.  
  42.